home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PsL Monthly 1993 December
/
PSL Monthly Shareware CD-ROM (December 1993).iso
/
prgmming
/
dos
/
pascal
/
fielddh.exe
/
FILE_LIB.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-02-06
|
3KB
|
117 lines
{$F+,O+} {since used to determine if overlay file exists!}
UNIT File_Lib;
INTERFACE
function File_Exist (File_Name : string) : boolean;
function Find_File_Along_Path (File_Name : string) : string;
{* Assumes path ends with a '/' *}
procedure Check_Valid_Path (Path_To_Ck : string;
VAR Ret_Status : integer);
function Get_Unique_FileName : string;
procedure Erase_File (File_Name : string;
Var Status : byte);
IMPLEMENTATION
USES
Str_Stf,
DOS;
{***********************************************************************}
function File_Exist (File_Name : string) : boolean;
var
DirInfo : DOS.SearchRec;
begin
DOS.FindFirst (File_Name, DOS.AnyFile, DirInfo);
IF (DOS.DosError = 0)
THEN File_Exist := TRUE
ELSE File_Exist := FALSE;
end; {File_Exist}
{***********************************************************************}
function Find_File_Along_Path (File_Name : string) : string;
begin
{*------------------------------------------------------------*}
{* Ok, Must check for file along the current PATH *}
{* Starting with the current path *}
{*------------------------------------------------------------*}
Find_File_Along_Path := DOS.FSearch (File_Name, DOS.GetEnv('PATH'));
end; {Find_File_Along_Path}
{***********************************************************************}
{* Assumes path ends with a '/' *}
procedure Check_Valid_Path (Path_To_Ck : string;
VAR Ret_Status : integer);
var
Curr_Path : string;
Dir : DOS.DirStr;
Ext : DOS.ExtStr;
Name : DOS.NameStr;
Temp_Str : string;
begin
Ret_Status := 0;
Temp_Str := TRIM (Path_To_Ck);
IF (Temp_Str = '')
THEN Ret_Status := -1
ELSE
BEGIN
Temp_Str := DOS.FExpand (Temp_Str);
DOS.FSplit (Temp_Str, Dir, Name, Ext);
IF ((Name <> '') or (Ext <> ''))
THEN Ret_Status := -2
ELSE IF (POS (':', Dir) <> 2)
THEN Ret_Status := -3
ELSE IF ((POS ('\', Dir) <> 3))
THEN Ret_Status := -4
ELSE
BEGIN {* Looks ok, check if directory exists *}
GetDir (0, Curr_Path);
DEC(Temp_Str[0]); {cut off last '\'}
{$I-} ChDir (Temp_Str); {$I+}
IF (IoResult <> 0)
THEN Ret_Status := -5;
ChDir (Curr_Path);
END;
END; {if}
end; {Check_Valid_Path}
{***********************************************************************}
function Get_Unique_FileName : string;
var
T_Hr, T_Min, T_Sec, T_100 : word;
begin
DOS.GetTime (T_Hr, T_Min, T_Sec, T_100);
Get_Unique_FileName := Int_To_Str(T_Hr)+Int_To_Str(T_Min)+
Int_To_Str(T_Sec)+Int_To_Str(T_100);
end; {get_unique_filename}
{***********************************************************************}
procedure Erase_File (File_Name : string;
Var Status : byte);
VAR
f : file;
begin
Status := 0;
Assign (F, File_Name);
{$I-} Reset (F); {I+}
IF (IOResult = 0) THEN
BEGIN
{$I-}
Close (F);
Erase (F);
{$I+}
IF (IOResult <> 0)
THEN Status := 2;
END
ELSE Status := 1;
end; {erase_file}
end. {unit File_Lib}